home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 43
/
Amiga Format CD43 (1999)(Future Publishing)(GB)(Track 1 of 2)[!][issue 1999-09].iso
/
-serious-
/
archivers
/
xpk
/
xpk_source
/
e
/
xpke.e
< prev
Wrap
Text File
|
1999-06-14
|
8KB
|
206 lines
/* $VER: xPKE 1.1 (16-4-97) © Frédéric RODRIGUES - Freeware
XPK Packing in E
xPKE is declared freeware. This is intended for a learning use to
encourage programming of XPK in E. Do whatever you want with the files
but keep all files unchanged and together if you distribute it and
mention my name on your creations if you use it. I would appreciate
little donations for my work (who knows somebody will send me something
- please, send me at least an email).
Reach me at : rodrigue@iles.siera.ups-tlse.fr (IP 130.120.84.50)
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
V1.0 (18-3-97) - First
Was not able to make ctrl-c break to function
There's a bug on the AmigaDos functions MatchFirst()
MatchEnd() : Fails when using wildcards without the
TARGET option (at least with my v37). Same bug on
original xPack.c.
V1.1 (16-4-97) - Now better than xPack.c and xpk.c because I could make
function ctrl-c break in the hook (see end of this)
Still the bug reported in V1.0
Corrected little (?) bug (xPackIt has it) which not copy
the comment,date,protection on the TARGET subdirectories
(it took me a while to implement this without sacrifying
the existent code)
Modified hook
Did a little better programing (guess what ?)
*/
OPT OSVERSION=36
MODULE 'xpk/xpk','xpkmaster','utility/tagitem','dos/dos','utility/hooks',
'dos/dosasl'
CONST MAXCHARFILE=256
ENUM ER_OK,ER_LIB,ER_XPK,ER_DOS,ER_MEM
CONST TAG_INNAMED=3,TAG_OUTNAMET=4,TAG_OUTNAMED=5,TAG_FILENAMED=11,
TAG_PACKMETHODD=13
ENUM ARG_FILES,ARG_TARGET,ARG_METHOD,ARG_PASSWORD,ARG_LOSSY,ARG_QUIET,
ARG_ALL,ARG_FORCE
DEF xpkerrmsg[XPKERRMSGSIZE]:STRING,tags:PTR TO LONG,
fib:PTR TO fileinfoblock,chunkhook:hook,myargs:PTR TO LONG,rdargs,
progress:PTR TO xpkprogress,files:PTR TO LONG,anchor:PTR TO anchorpath,
outfile[MAXCHARFILE]:STRING,lock,achain:PTR TO achain,xpkfib:xpkfib,
size,curdir[MAXCHARFILE]:STRING
PROC main() HANDLE
DEF err,delete
WriteF('\e[1m$VER: xPKE 1.1 (16-4-97) © Frédéric RODRIGUES - Freeware\n'+
'\e[4mXPK Packing in E\n\n\e[22m\e[24m')
myargs:=[NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL]
IF (rdargs:=ReadArgs('FILES/M/A,TARGET/K,METHOD/K,PASSWORD/K,LOSSY/S,'+
'QUIET/S,ALL/S,FORCE/S',
myargs,NIL))=NIL THEN Raise(ER_DOS)
IF (xpkbase:=OpenLibrary('xpkmaster.library',2))=NIL THEN Raise(ER_LIB)
chunkhook.entry:={chunkfunc}
GetCurrentDirName(curdir,StrMax(curdir))
SetStr(curdir,StrLen(curdir))
IF curdir[StrLen(curdir)-1]<>":" THEN StrAdd(curdir,'/',ALL)
tags:=[XPK_GETERROR,xpkerrmsg,
XPK_INNAME,NIL,
XPK_OUTNAME,NIL,
XPK_PASSWORD,myargs[ARG_PASSWORD],
IF myargs[ARG_QUIET] THEN TAG_IGNORE ELSE XPK_CHUNKHOOK,chunkhook,
XPK_FILENAME,NIL,
IF myargs[ARG_METHOD] THEN XPK_PACKMETHOD ELSE TAG_DONE,myargs[ARG_METHOD],
IF myargs[ARG_LOSSY] THEN XPK_LOSSYOK ELSE TAG_IGNORE,myargs[ARG_LOSSY],
XPK_GETOUTLEN,{size},TAG_DONE]
IF myargs[ARG_PASSWORD] THEN myargs[ARG_FORCE]:=TRUE
files:=myargs[ARG_FILES]
IF (anchor:=New(SIZEOF anchorpath+MAXCHARFILE))=NIL THEN Raise(ER_MEM)
anchor.breakbits:=SIGBREAKF_CTRL_C
anchor.strlen:=MAXCHARFILE-1
WHILE files[]
err:=MatchFirst(files[]++,anchor)
WHILE err=0
fib:=anchor.info
IF fib.direntrytype>0
IF ((anchor.flags AND APF_DIDDIR)=0) AND myargs[ARG_ALL] THEN anchor.flags:=anchor.flags OR APF_DODIR
anchor.flags:=anchor.flags AND Not(APF_DIDDIR)
ELSE
achain:=anchor.last
lock:=CurrentDir(achain.lock)
tags[TAG_INNAMED]:=fib.filename
IF myargs[ARG_TARGET] THEN makeoutfile(outfile,anchor+SIZEOF anchorpath) ELSE StringF(outfile,'xPKE\z\h[8]',FindTask(NIL))
tags[TAG_OUTNAMED]:=outfile
tags[TAG_FILENAMED]:=fib.filename
delete:=TRUE
IF fib.protection AND FIBF_DELETE AND (myargs[ARG_TARGET]=FALSE)
WriteF('\e[33mSkip\e[31m: \s delete protected\n',fib.filename)
delete:=FALSE
ELSE
IF tags[TAG_PACKMETHODD]
tags[TAG_OUTNAMET]:=TAG_DONE
IF XpkExamine(xpkfib,tags)<>0 THEN Raise(ER_XPK)
tags[TAG_OUTNAMET]:=XPK_OUTNAME
IF xpkfib.type=XPKTYPE_UNPACKED OR myargs[ARG_FORCE]
size:=0
IF XpkPack(tags)<>0 THEN Raise(ER_XPK)
IF (size>fib.size) AND (myargs[ARG_FORCE]=FALSE)
DeleteFile(tags[TAG_OUTNAMED])
WriteF('\e[33mSkip\e[31m: \s not packable\n',fib.filename)
IF myargs[ARG_TARGET] THEN copy(tags[TAG_INNAMED],tags[TAG_OUTNAMED])
delete:=FALSE
ENDIF
ELSE
WriteF('\e[33mSkip\e[31m: \s already packed\n',fib.filename)
IF myargs[ARG_TARGET] THEN copy(tags[TAG_INNAMED],tags[TAG_OUTNAMED])
delete:=FALSE
ENDIF
ELSE
IF (err:=XpkUnpack(tags))<>0
IF err=XPKERR_NOTPACKED
WriteF('\e[33mSkip\e[31m: \s not packed\n',fib.filename)
IF myargs[ARG_TARGET] THEN copy(tags[TAG_INNAMED],tags[TAG_OUTNAMED])
delete:=FALSE
ELSE
Raise(ER_XPK)
ENDIF
ENDIF
ENDIF
ENDIF
SetComment(tags[TAG_OUTNAMED],fib.comment)
SetProtection(tags[TAG_OUTNAMED],fib.protection)
SetFileDate(tags[TAG_OUTNAMED],fib.datestamp)
IF (myargs[ARG_TARGET]=FALSE) AND delete
IF DeleteFile(tags[TAG_INNAMED])=FALSE THEN Raise(ER_DOS)
IF Rename(tags[TAG_OUTNAMED],tags[TAG_INNAMED])=FALSE THEN Raise(ER_DOS)
ENDIF
CurrentDir(lock)
lock:=NIL
ENDIF
err:=MatchNext(anchor)
ENDWHILE
IF err<>ERROR_NO_MORE_ENTRIES THEN Raise(ER_DOS)
MatchEnd(anchor)
ENDWHILE
anchor:=NIL
Raise(ER_OK)
EXCEPT
IF xpkbase THEN CloseLibrary(xpkbase)
IF rdargs THEN FreeArgs(rdargs)
IF lock THEN CurrentDir(lock)
IF anchor THEN MatchEnd(anchor)
SELECT exception
CASE ER_DOS;PrintFault(IoErr(),'\e[32mxPKE\e[31m');RETURN RETURN_FAIL
CASE ER_LIB;WriteF('\e[32mxPKE\e[31m: cannot open xpkmaster.library');RETURN RETURN_ERROR
CASE ER_XPK;WriteF('\e[32mxPKE\e[31m: \s\n',xpkerrmsg);RETURN RETURN_FAIL
CASE ER_MEM;PrintFault(ERROR_NO_FREE_STORE,'\e[32mxPKE\e[0m');RETURN RETURN_ERROR
ENDSELECT
ENDPROC
PROC makeoutfile(outfile,infile)
DEF p=-1,buf[MAXCHARFILE]:STRING,len,indir[MAXCHARFILE]:STRING,
lock,fib:fileinfoblock,i
StrCopy(outfile,myargs[ARG_TARGET],ALL)
IF outfile[StrLen(outfile)-1]<>":" THEN StrAdd(outfile,'/',ALL)
len:=StrLen(outfile)
MidStr(buf,infile,InStr(infile,':',0)+1,ALL)
StrAdd(outfile,buf,ALL)
WHILE (p:=InStr(outfile,'/',p+1))<>-1
FOR i:=0 TO StrMax(buf)-1 DO buf[i]:=0
MidStr(buf,outfile,0,p)
UnLock(CreateDir(buf))
StrCopy(indir,curdir,ALL)
StrAdd(indir,buf+len,ALL)
IF (lock:=Lock(indir,SHARED_LOCK))=0 THEN Raise(ER_DOS)
IF Examine(lock,fib)=FALSE THEN Raise(ER_DOS)
SetComment(buf,fib.comment)
SetProtection(buf,fib.protection)
SetFileDate(buf,fib.datestamp)
UnLock(lock)
ENDWHILE
ENDPROC
PROC copy(src,dest) HANDLE
DEF buf[512]:STRING,fhsrc,fhdest,nbytes
IF (fhsrc:=Open(src,OLDFILE))=NIL THEN Raise(ER_DOS)
IF (fhdest:=Open(dest,NEWFILE))=NIL THEN Raise(ER_DOS)
WHILE (nbytes:=Read(fhsrc,buf,512))>0
IF Write(fhdest,buf,nbytes)<>nbytes THEN Raise(ER_DOS)
ENDWHILE
IF nbytes<0 THEN Raise(ER_DOS)
Raise(ER_OK)
EXCEPT
IF fhsrc THEN Close(fhsrc)
IF fhdest THEN Close(fhdest)
IF exception=ER_DOS THEN Raise(ER_DOS)
ENDPROC
PROC chunkfunc()
MOVE.L A1,progress
WriteF('\b\s - \e[1m\s\e[22m - \d/\d kb, \d% CF, \e[1m\d% done\e[22m',
progress.activity,progress.filename,progress.ccur/1024,
progress.ulen/1024,progress.cf,progress.done)
IF (progress.type=XPKPROG_END) THEN WriteF('\e[11D at \d b/s\n',progress.speed)
ENDPROC CtrlC()